------------------------------------------------------------------------
<subsectionstar3_9_7.html> <section3_9.html> <subsectionstar3_9_5.html>
* Next:* unlock.bas <subsectionstar3_9_7.html> *Up:* Code Listing
<section3_9.html> * Previous:* rti-815.bas <subsectionstar3_9_5.html>
------------------------------------------------------------------------


    tek222.bas


'
'  Author:  Terence Kelly
'  Date:    5 September 1995
'
'  This module contains functions for talking to the Tektronix 222
'  oscilloscope through a serial port.
'
'  On 8/22/95 Prof. Littman and I spent a great deal of time
'  configuring the serial port on the 486 used with the WEBRTI
'  project in order to enable it to speak to the Tektronix 222.
'  Here are the settings for COM1 and COM2 that we finally
'  settled on (we use COM1 for Tektronix communications):
'
'                                   COM1            COM2
'
'           Memory address:         03F8            02F8
'           Baud rate:              2400            2400
'           Parity:                 N               N
'           Data bits:              8               8
'           Stop bits:              1               1
'           IRQ:                    4               3
'
'----------------------------------------------------------------------------

Global Const Tek_COMPortNumber% = 1
Global Const Tek_COMPortSettings$ = "2400,N,8,1"

'  Keeps track of how many waveforms we've captured; used in
'  naming output files.
Global WaveformCount As Integer

Function Tek_AcqMode (ByVal N%) As String
    '
    '  Given a number in the range 0-3, return the corresponding
    '  acquisition mode string from table 5, page 13 of "222 RS-232
    '  Interface Guide."
    '

    R$ = ""

    If N% < 0 Or N% > 3 Then
        R$ = "Error in routine Tek_AcqMode: "
        Tek_AcqMode = R$ & Str$(N%) & " not valid parameter"
        Exit Function
    End If

    Select Case N%
    Case 0
        R$ = "NORM"
    Case 1
        R$ = "ENV"
    Case 2
        R$ = "AVG"
    Case 3
        R$ = "CENV"
    Case Else
        R$ = "Error in routine Tek_AcqMode: unclassified parameter"
    End Select

    Tek_AcqMode = R$

End Function

Function Tek_CPLG (ByVal N%) As String
    '
    '  Given a number in the range 0-3, return the corresponding
    '  CPLG string from tables 1 and 2, pp. 10-11 of "222 RS-232
    '  Interface Guide."
    '

    R$ = ""

    If N% < 0 Or N% > 3 Then
        R$ = "Error in routine Tek_CPLG: "
        Tek_CPLG = R$ & Str$(N%) & " is an invalid parameter"
        Exit Function
    End If

    Select Case N%
    Case 0
        R$ = "DC"
    Case 1
        R$ = "AC"
    Case 2
        R$ = "GND"
    Case 3
        R$ = "OFF"
    Case Else
        R$ = "Error in routine Tek_CPLG: unclassified parameter"
    End Select

    Tek_CPLG = R$

End Function

Function Tek_ErrorMsg (ByVal in$) As String
    '
    '  Given a string, search it for a Tektronix error message.  If
    '  an Error message is found in the input string, return the
    '  "long version" of the error message.  See p. 14 of the "222
    '  RS-232 Interfacing Guide" for details.  This function only
    '  handles status codes, not diagnostic error codes.  I've never
    '  had the scope give me a diagnostic error code, but it has
    '  often spit back status codes complaining about commands I've
    '  sent it.
    '

    R$ = ""
    S$ = Trim$(CondenseWhitespace(in$))
    I% = InStr(S$, "STA")
    If I% > 0 Then
        C$ = Mid$(S$, I%)
        Select Case Mid$(Split(C$, 2, " "), 1, 4)
        Case "0001"
            R$ = "Unrecognized command"
        Case "0002"
            R$ = "Unrecognized character"
        Case "0003"
            R$ = "Command is query only"
        Case "0004"
            R$ = "Command has no query"
        Case "0005"
            R$ = "Bad command argument"
        Case "0006"
            R$ = "Bad data"
        Case "0007"
            R$ = "Data is required"
        Case "0008"
            R$ = "Argument is required"
        Case "0009"
            R$ = "Communication task busy"
        Case "000A"
            R$ = "CURV command had bad checksum"
        Case "000B"
            R$ = "Bad task name for message"
        Case "FFFF"
            R$ = "User pressed escape"
        Case Else
            R$ = "WEBRTI function Tek_ErrorMsg does not recognize"
            R$ = R$ & " this status code"
        End Select
    End If

    If InStr(UCase$(S$), "ERR") Then
        If R$ <> "" Then R$ = R$ & ".  "
        R$ = R$ & "Diagnostic error code: see 222 RS-232 user "
        R$ = R$ & "interface guide"
    End If

    Tek_ErrorMsg = R$

End Function

Function Tek_FP (ByVal logfp$) As String
    '
    '  Get the front panel settings of the Tektronix scope and return
    '  them along with a human-readable decoding.
    '

    FP$ = Tek_send("3", "FP? " & logfp$)
    R$ = Trim$(Tek_InsertErrorMsgs(CondenseWhitespace(FP$)))

    If InStr(R$, "STA") Or InStr(R$, "ERR") Then
        Tek_FP = R$
    Else
        R$ = R$ & CRLF()
        Tek_FP = R$ & Tek_FPDecode(Mid$(FP$, InStr(FP$, ":") + 1, 10))
    End If

End Function

Function Tek_FPDecode (ByVal FP$) As String
    '
    '  Given a ten-character string representing the Tektronix 222
    '  response to the FP? command, decode this string into human-
    '  readable form according to tables 1 through 5, pp. 10 - 13
    '  of the "222 RS-232 Interface Guide."
    '

    If Len(FP$) <> 10 Then
        R$ = "Error in routine Tek_FPDecode: Len(parameter) != 10"
        Tek_FPDecode = R$
        Exit Function
    End If

    C$ = CRLF()
    R$ = ""

    ' channel 1
    Ch$ = Mid$(FP$, 1, 1)
    R$ = R$ & " CH1INV="
    R$ = R$ & UCase$(Format$(HexExtract(Ch$, 0, 1), "On/Off")) & C$
    R$ = R$ & " CH1VAR="
    R$ = R$ & UCase$(Format$(HexExtract(Ch$, 1, 1), "On/Off")) & C$
    R$ = R$ & "CH1CPLG=" & Tek_CPLG(HexExtract(Ch$, 2, 2)) & C$
    R$ = R$ & " CH1V/D=" & Tek_VoltsDiv(Mid$(FP$, 2, 1)) & C$
    
    ' channel 2
    Ch$ = Mid$(FP$, 3, 1)
    R$ = R$ & " CH2INV="
    R$ = R$ & UCase$(Format$(HexExtract(Ch$, 0, 1), "On/Off")) & C$
    R$ = R$ & " CH2VAR="
    R$ = R$ & UCase$(Format$(HexExtract(Ch$, 1, 1), "On/Off")) & C$
    R$ = R$ & "CH2CPLG=" & Tek_CPLG(HexExtract(Ch$, 2, 2)) & C$
    R$ = R$ & " CH2V/D=" & Tek_VoltsDiv(Mid$(FP$, 4, 1)) & C$

    ' Table 3: Sec/Div and Misc. settings
    Ch$ = Mid$(FP$, 5, 2)
    R$ = R$ & " RO-OFF="
    R$ = R$ & UCase$(Format$(HexExtract(Ch$, 0, 1), "On/Off")) & C$
    R$ = R$ & "     XY="
    R$ = R$ & UCase$(Format$(HexExtract(Ch$, 1, 1), "On/Off")) & C$
    R$ = R$ & " X10MAG="
    R$ = R$ & UCase$(Format$(HexExtract(Ch$, 2, 1), "On/Off")) & C$
    R$ = R$ & "SEC/DIV=" & Tek_SecDiv(HexExtract(Ch$, 3, 5)) & C$

    ' Table 4:  Trigger Position, Slope, Source and Mode Settings
    Ch$ = Mid$(FP$, 7, 2)
    R$ = R$ & "TRIGPOS=" & Tek_TrigPos(HexExtract(Ch$, 0, 2)) & C$
    R$ = R$ & "  SLOPE=" & Tek_TrigSlope(HexExtract(Ch$, 2, 1)) & C$
    R$ = R$ & "TRIGSRC=" & Tek_TrigSource(HexExtract(Ch$, 3, 2)) & C$
    R$ = R$ & "TRIGMOD=" & Tek_TrigMode(HexExtract(Ch$, 5, 3)) & C$

    ' Table 5:  Acquisition Mode and Misc. Settings
    Ch$ = Mid$(FP$, 9, 2)
    ' Decoding of Timeout is perverse; see table 5
    R$ = R$ & "    TIMEOUT="
    R$ = R$ & UCase$(Format$(HexExtract(Ch$, 0, 1) - 1, "Yes/No")) & C$
    R$ = R$ & "    CHANSEL="
    R$ = R$ & IIf(HexExtract(Ch$, 1, 1), "CH1", "CH2") & C$
    R$ = R$ & "RECALLEDWFM="
    R$ = R$ & UCase$(Format$(HexExtract(Ch$, 2, 1), "Yes/No")) & C$
    R$ = R$ & " VALIDSTORE="
    R$ = R$ & UCase$(Format$(HexExtract(Ch$, 3, 1), "Yes/No")) & C$
    R$ = R$ & "    ACQMODE=" & Tek_AcqMode(HexExtract(Ch$, 4, 2)) & C$
    R$ = R$ & "  STOREMODE="
    R$ = R$ & IIf(HexExtract(Ch$, 6, 1), "STORE", "NONSTORE") & C$
    R$ = R$ & "   AUTOTRIG="
    R$ = R$ & UCase$(Format$(HexExtract(Ch$, 7, 1), "Yes/No")) & C$
    
    Tek_FPDecode = R$

End Function

Function Tek_get () As String
    '
    '  Get waveforms CH1 and CH2, store them in files.  Use global
    '  integer to keep track of how many non-null waveform files
    '  we've succeeded in grabbing from the scope.  Return a string
    '  containing information on the number of bytes
    '
    '  We assume that the scope is in SSEQ trigger mode and that
    '
    '  See the Tektronix manual entitled "222 RS-232 Interface Guide"
    '  for details on the button numbering scheme, trigger modes, etc.
    '

    Const Delay$ = "7"     ' CURV? commands take a while.

    R$ = ""

    ' record the time that this routine is invoked
    CapTime$ = Format$(Now, "hh:mm:ss m/d/yy")
    ' grab the waveforms
    CH1$ = Tek_send(Delay$, "curv? ch1")
    CH2$ = Tek_send(Delay$, "curv? ch2")
    ' store nonzero length waveforms to disk
    If CH1$ <> "" Then
        WaveformCount = WaveformCount + 1
        Filename$ = RTIDir$ & "TEK_" & Format$(WaveformCount, "0000")
        Filename$ = Filename$ & ".WFM"
        Call ClobberFile(Filename$, CH1$)
    End If
    If CH2$ <> "" Then
        WaveformCount = WaveformCount + 1
        Filename$ = RTIDir$ & "TEK_" & Format$(WaveformCount, "0000")
        Filename$ = Filename$ & ".WFM"
        Call ClobberFile(Filename$, CH2$)
    End If
    R$ = " Bytes received: CH1=" & Trim$(Str$(Len(CH1$)))
    R$ = R$ & ", CH2=" & Trim$(Str$(Len(CH2$))) & " at " & CapTime$

    Tek_get = R$

End Function

Function Tek_initialize () As String
    '
    '  Initialize the MSCOMM control used to communicate with the
    '  222 oscilloscope. Return any error messages that occur during
    '  this process.
    '

    On Error GoTo Tek_Initialize_Error

    strErrors$ = ""
    Tek_initialize = ""
    frmWEBRTIcontrols.Hide   ' form containing MSCOMM control
    frmWEBRTIcontrols.Comm1.CommPort = Tek_COMPortNumber%
    frmWEBRTIcontrols.Comm1.settings = Tek_COMPortSettings$
    frmWEBRTIcontrols.Comm1.InputLen = 0
    frmWEBRTIcontrols.Comm1.InBufferSize = 4096
    frmWEBRTIcontrols.Comm1.PortOpen = True
    frmWEBRTIcontrols.Comm1.OutBufferCount = 0
    frmWEBRTIcontrols.Comm1.InBufferCount = 0
    frmWEBRTIcontrols.Comm1.Output = Chr$(13)
    Delay (1)
    strReply$ = Trim$(CondenseWhitespace(frmWEBRTIcontrols.Comm1.Input))
    frmWEBRTIcontrols.Comm1.PortOpen = False
    Tek_initialize = Tek_InsertErrorMsgs(strReply$) & strErrors$

Exit Function

Tek_Initialize_Error:
    If strErrors$ <> "" Then strErrors$ = strErrors$ & CRLF()
    T$ = strErrors$ & "Error " & Str$(Err)
    strErrors$ = T$ & " (VB) in function Tek_initialize: " & Error(Err)
    Resume Next

End Function

Function Tek_InsertErrorMsgs (ByVal in$) As String
    '
    '  Given a reply string from the Tektronix scope, insert a
    '  parenthesized error message within every semicolon-delimited
    '  individual reply containing a STA or ERR notice.
    '
    '  We assume that the last semicolon-delimited field of the
    '  string returned by the Tektronix scope is empty.
    '
    R$ = ""

    For I% = 1 To NumOccur(in$, ";")
        Msg$ = Split(in$, I%, ";")
        E$ = Tek_ErrorMsg(Msg$)
        If E$ <> "" Then
            R$ = R$ & Msg$ & " (" & E$ & "); "
        Else
            R$ = R$ & Msg$ & "; "
        End If
    Next

    Tek_InsertErrorMsgs = R$

End Function

Function Tek_SecDiv (ByVal N%) As String
    '
    '  Given an integer in the range 0 - 26 return a string
    '  containing the corresponding Seconds/Division setting listed
    '  in Table 3, p. 12 of the Tektronix "222 RS-232 Interface
    '  Guide " or an error message."
    '
    If N% < 0 Or N% > 26 Then
        R$ = "Error in routine Tek_SecDiv: " & Str$(N%)
        Tek_SecDiv = R$ & " not a valid parameter (out of range)"
        Exit Function
    End If

    Select Case N%
    Case 0
        R$ = "50 nS"
    Case 1
        R$ = "0.1 uS"
    Case 2
        R$ = "0.2 uS"
    Case 3
        R$ = "0.5 uS"
    Case 4
        R$ = "1 uS"
    Case 5
        R$ = "2 uS"
    Case 6
        R$ = "5 uS"
    Case 7
        R$ = "10 uS"
    Case 8
        R$ = "20 uS"
    Case 9
        R$ = "50 uS"
    Case 10
        R$ = "0.1 mS"
    Case 11
        R$ = "0.2 mS"
    Case 12
        R$ = "0.5 mS"
    Case 13
        R$ = "1 mS"
    Case 14
        R$ = "2 mS"
    Case 15
        R$ = "5 mS"
    Case 16
        R$ = "10 mS"
    Case 17
        R$ = "20 mS"
    Case 18
        R$ = "50 mS"
    Case 19
        R$ = "0.1 S"
    Case 20
        R$ = "0.2 S"
    Case 21
        R$ = "0.5 S"
    Case 22
        R$ = "1 S"
    Case 23
        R$ = "2 S"
    Case 24
        R$ = "5 S"
    Case 25
        R$ = "10 S"
    Case 26
        R$ = "20 S"
    Case Else
        R$ = "Error in routine Tek_SecDiv: unclassified parameter"
    End Select

    Tek_SecDiv = R$

End Function

Function Tek_send (ByVal Delay$, ByVal S$) As String
    '
    '  Send the given string to the Tektronix scope and return
    '  whatever the scope replies.  Wait Delay$ seconds before
    '  reading the scope's reply.  It is the user/programmer's
    '  responsibility to choose Delay$ wisely.
    '

    On Error GoTo Tek_send_Error

    D% = IIf(Val(Delay$) > 0, Val(Delay$), 1)
    frmWEBRTIcontrols.Comm1.PortOpen = True
    frmWEBRTIcontrols.Comm1.OutBufferCount = 0
    frmWEBRTIcontrols.Comm1.InBufferCount = 0
    frmWEBRTIcontrols.Comm1.Output = S$ & Chr$(13)
    Delay (D%)
    strReply$ = frmWEBRTIcontrols.Comm1.Input
    frmWEBRTIcontrols.Comm1.PortOpen = False

    Tek_send = strReply$

Exit Function

Tek_send_Error:
    R$ = "Error " & Str$(Err) & " (VB) in function Tek_send: "
    Tek_send = R$ & Error$(Err)
    Exit Function

End Function

Function Tek_TrigMode (ByVal N%) As String
    '
    '  Given a number in the range 0-3, return the corresponding
    '  trigger mode string from table 4, page 13 of "222 RS-232
    '  Interface Guide."
    '

    If N% < 0 Or N% > 3 Then
        R$ = "Error in routine Tek_TrigMode: " & Str$(N%)
        Tek_TrigMode = R$ & " not valid parameter (out of range)"
        Exit Function
    End If

    Select Case N%
    Case 0
        R$ = "NORM"
    Case 1
        R$ = "AUTOLVL"
    Case 2
        R$ = "AUTOBL"
    Case 3
        R$ = "SSEQ"
    Case Else
        R$ = "Error in routine Tek_TrigMode: unclassified parameter"
    End Select

    Tek_TrigMode = R$

End Function

Function Tek_TrigPos (ByVal N%) As String
    '
    '  Given an integer in the range 0-2, return the corresponding
    '  trigger position string from table 4, p. 13 of "222 RS-232
    '  Interface Guide."
    '
    If N% < 0 Or N% > 2 Then
        R$ = "Error in routine Tek_TrigPos: " & Str$(N%)
        Tek_TrigPos = R$ & " not valid parameter (out of range)"
        Exit Function
    End If

    Select Case N%
    Case 0
        R$ = "POST"
    Case 1
        R$ = "MID"
    Case 2
        R$ = "PRE"
    Case Else
        R$ = "Error in routine Tek_TrigPos: unclassified parameter"
    End Select

    Tek_TrigPos = R$

End Function

Function Tek_TrigSlope (ByVal N%) As String
    '
    '  Given a number in the range 0-1, return the corresponding
    '  trigger slope string from table 4, page 13 of "222 RS-232
    '  Interface Guide."
    '
    '  This function could really be replaced with an IIf statement.
    '

    If N% < 0 Or N% > 1 Then
        R$ = "Error in routine Tek_TrigSlope: " & Str$(N%)
        Tek_TrigSlope = R$ & " not valid parameter"
        Exit Function
    End If

    Select Case N%
    Case 0
        R$ = "NEG"
    Case 1
        R$ = "POS"
    Case Else
        R$ = "Error in routine Tek_TrigSlope: unclassified parameter"
    End Select

    Tek_TrigSlope = R$

End Function

Function Tek_TrigSource (ByVal N%) As String
    '
    '  Given a number in the range 0-3, return the corresponding
    '  trigger source string from table 4, page 13 of "222 RS-232
    '  Interface Guide."
    '

    If N% < 0 Or N% > 3 Then
        R$ = "Error in routine Tek_TrigSource: " & Str$(N%)
        Tek_TrigSource = R$ & " not valid parameter"
        Exit Function
    End If

    Select Case N%
    Case 0
        R$ = "VERT"
    Case 1
        R$ = "CH1"
    Case 2
        R$ = "CH2"
    Case 3
        R$ = "EXT"
    Case Else
        R$ = "Error in routine Tek_TrigSource: unclassified parameter"
    End Select

    Tek_TrigSource = R$

End Function

Function Tek_VoltsDiv (ByVal Ch$) As String
    '
    '  Given a hex character in the range 0 - C, return the
    '  corresponding volts/division setting from tables 1 and 2,
    '  pp. 10-11 of the "222 RS-232 Interface Guide"
    '

    N% = Val("&H" & Ch$)
    If Len(Ch$) <> 1 Or N% > 12 Or N% < 0 Then
        R$ = "Error in routine Tek_VoltsDiv: " & Ch$
        Tek_VoltsDiv = R$ & " is not a valid parameter (out of range)"
        Exit Function
    End If

    Select Case N%
    Case 0
        R$ = "5 mV"
    Case 1
        R$ = "10 mV"
    Case 2
        R$ = "20 mV"
    Case 3
        R$ = "50 mV"
    Case 4
        R$ = "0.1 V"
    Case 5
        R$ = "0.2 V"
    Case 6
        R$ = "0.5 V"
    Case 7
        R$ = "1 V"
    Case 8
        R$ = "2 V"
    Case 9
        R$ = "5 V"
    Case 10
        R$ = "10 V"
    Case 11
        R$ = "20 V"
    Case 12
        R$ = "50 V"
    Case Else
        R$ = "Error in routine Tek_VoltsDiv: unclassified parameter"
    End Select

    Tek_VoltsDiv = R$

End Function

------------------------------------------------------------------------

/tpkelly@cs.CS.Princeton.EDU
Thu Sep 14 02:35:48 EDT 1995/